COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C****** DISKO, CLOSIT, BLOCK DATA (DSK CHANNELS), PACKER, PACKX ******
C00005 ENDMK
C⊗;
C****** DISKO, CLOSIT, BLOCK DATA (DSK CHANNELS), PACKER, PACKX ******
  	SUBROUTINE DISKO(N,RNAM,J)
C N=DEVICE NUMBER, RNAM=FILE NAME, J=0=OUTPUT, =-1=INPUT
C J=1=UNFORMATTED IN, =2=UNFORMATTED OUT
C J=3=FORMATTED IN,   =4=FORMATTED OUT
	GO TO (1,2,3,4)J 

1        CALL IFILE(N,RNAM)
CXX	CALL OPEN(N,RNAM,0,'RDO',,,'UNF')
	RETURN
2        CALL OFILE(N,RNAM)
CXX	CALL OPEN(N,RNAM,0,'NEW',,,'UNF')
	RETURN
3        CALL IFILE(N,RNAM)
CXX	CALL OPEN(N,RNAM,0,'RDO',,,'FOR')
	RETURN
4        CALL OFILE(N,RNAM)
CXX	CALL OPEN(N,RNAM,0,'NEW',,,'FOR')
	RETURN
	END

	SUBROUTINE CLOSIT(IDEV)
CXX	CALL CLOSE(IDEV)
	ENDFILE IDEV
	END

	BLOCK DATA
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	DATA JTYPE/5/,ID23/23/,ID20/20/,ID1/1/,ID21/21/
	END

	SUBROUTINE PACKER(RNAM,INP)
	DIMENSION INP(1),KNM(5)
	DATA IBLA/' '/,ISEMI/';'/,IARO/"575004020100/,IEQU/'='/
C ABOVE FOR PDP10 ONLY*********
C N=WDCNT 
C****** THE BIG NUMBER=LEFT ARROW

	DO 1 J=1,80
	N=INP(J)
	IF(N.EQ.IARO.OR.N.EQ.IEQU)GO TO 2
1	IF(N.EQ.IBLA.OR.N.EQ.ISEMI)GO TO 2
2	II=J
	J=J-1
	N=J
	IF(J.GT.4)N=4
4	DO 10 K=1,4
	IF(K.GT.N)GO TO 11
	KNM(K)=INP(K)
	GO TO 10
11	KNM(K)=IBLA
10	CONTINUE
	CALL PACKX(RNAM,KNM)
	RETURN
	END

	SUBROUTINE PACKX(NAM,KNM)
	DIMENSION KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	1 , MM/"774000000000/,IBLA/' '/
	KNM(5)=IBLA
C  BECAUSE 5 CHARS IN PDP10 WORD.
	NAM=0
	DO 12 K=5,1,-1
	NAM=NAM .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)RETURN
17	IF (NAM.GE.0)GO TO 13
	NAM = (( NAM .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NAM = NAM / KK
12	CONTINUE
	RETURN
	END

C11	SUBROUTINE PACKX(A4RET,KPAC)
C11	DIMENSION KPAC(1)
C11	LOGICAL*1 A4RET(4)
C11	DO 1 K=1,4
C11 1	A4RET(K)=KPAC(K)
C PACKS 4 CHARS. INTO SINGLE, REAL WORD (4 BYTES)
C11	RETURN
C11	END